home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / bdeorx / BDEDORX.ZIP / BDEDoRx / Bdedorx2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-07  |  8.8 KB  |  324 lines
  1. unit BDEDoRx2;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, BDEDoRxS, DB, DBTables, DBITypes, DBIProcs,
  8.   DBIErrs, FileCtrl, ExtCtrls, Menus;
  9.  
  10. type
  11.   TRefIntFrm = class(TForm)
  12.     ListBox1: TListBox;
  13.     ListBox2: TListBox;
  14.     ListBox3: TListBox;
  15.     FileListBox1: TFileListBox;
  16.     AddBtn: TButton;
  17.     CloseBtn: TButton;
  18.     Edit1: TEdit;
  19.     RadioGroup1: TRadioGroup;
  20.     CheckBox1: TCheckBox;
  21.     Bevel1: TBevel;
  22.     Label2: TLabel;
  23.     Bevel2: TBevel;
  24.     Label1: TLabel;
  25.     ListBox4: TListBox;
  26.     DelBtn: TButton;
  27.     Bevel3: TBevel;
  28.     Bevel4: TBevel;
  29.     Label3: TLabel;
  30.     Label4: TLabel;
  31.     Label5: TLabel;
  32.     Label6: TLabel;
  33.     Label7: TLabel;
  34.     PopupMenu1: TPopupMenu;
  35.     RIInfo: TMenuItem;
  36.     DepInfo: TMenuItem;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure ListBox1DblClick(Sender: TObject);
  39.     procedure FileListBox1DblClick(Sender: TObject);
  40.     procedure ListBoxesDrawItem(Control: TWinControl; Index: Integer;
  41.       Rect: TRect; State: TOwnerDrawState);
  42.     procedure AddBtnClick(Sender: TObject);
  43.     procedure Edit1Change(Sender: TObject);
  44.     procedure DelBtnClick(Sender: TObject);
  45.     procedure ListBox4Click(Sender: TObject);
  46.     procedure CloseBtnClick(Sender: TObject);
  47.     procedure RIInfoClick(Sender: TObject);
  48.     procedure PopupMenu1Popup(Sender: TObject);
  49.     procedure DepInfoClick(Sender: TObject);
  50.   private
  51.     { Private-Deklarationen }
  52.     procedure SetControlState;
  53.   public
  54.     { Public-Deklarationen }
  55.   end;
  56.  
  57. var
  58.   RefIntFrm: TRefIntFrm;
  59.  
  60. implementation
  61.  
  62. uses BDEDoRx1, BDEDoRx6;
  63.  
  64. {$R *.DFM}
  65.  
  66. function GetDBPath(AliasName: string): TFileName;
  67. var ParamList: TStringList;
  68.     i: integer;
  69. begin
  70.   ParamList := TStringList.Create;
  71.   with Session do
  72.   try
  73.     for i:=0 to pred(DatabaseCount) do
  74.       if (Databases[i].DatabaseName = AliasName) then
  75.         ParamList.Assign(Databases[i].Params);
  76.     Result := UpperCase(ParamList.Values['PATH'])+'\';
  77.   finally
  78.     Paramlist.Free;
  79.   end;
  80. end;
  81.  
  82. procedure TRefIntFrm.ListBox1DblClick(Sender: TObject);
  83. begin
  84.   with ListBox1 do
  85.   if (ListBox2.Items.IndexOf(Items.Strings[ItemIndex]) = -1) then
  86.     ListBox2.Items.Add(Items.Strings[ItemIndex])
  87.   else
  88.     ListBox2.Items.Delete(ListBox2.Items.IndexOf(Items.Strings[ItemIndex]));
  89. end;
  90.  
  91. function GetFldType(const FldName: string; FldList: TDoRxList): string;
  92. var i: integer;
  93. begin
  94.   for i:=0 to pred(FldList.Count) do
  95.     if CompareText(TStringList(FldList.Items[i]).Strings[0],FldName) = 0 then
  96.       Result := TStringList(FldList.Items[i]).Strings[1];
  97. end;
  98.  
  99. function GetFldTypeFromString(const FldName: string): string;
  100. begin
  101.   Result := Copy(FldName,Pos('(',FldName),3);
  102. end;
  103.  
  104. function StripFldTypeFromString(const FldName: string): string;
  105. begin
  106.   Result := FldName;
  107.   Delete(Result,Pos('(',FldName)-1,4);
  108. end;
  109.  
  110. function CompareFldTypes(const FldName1, FldName2: string): boolean;
  111. var c1,c2: string[1];
  112. begin
  113.   c1 := GetFldTypeFromString(FldName1);
  114.   c2 := GetFldTypeFromString(FldName2);
  115.   Result := (CompareText(c1,c2) = 0)
  116.             or ((c1[1] in ['I','+']) and (c2[1] in ['I','+']));
  117. end;
  118.  
  119. procedure TRefIntFrm.FileListBox1DblClick(Sender: TObject);
  120. var TmpTbl: TTable;
  121.     TmpFld: string;
  122.     Pos, i: integer;
  123.     FldList: TDoRxList;
  124. begin
  125.   if FileListBox1.ItemIndex = -1 then Exit;
  126.   ListBox3.Items.Clear;
  127.   TmpTbl := TTable.Create(nil);
  128.   with TmpTbl do
  129.   try
  130.     DataBaseName := MainFrm.Database1.DatabaseName;
  131.     TableName := ExtractFileName(FileListBox1.FileName);
  132.     Open;
  133.     IndexDefs.Update;
  134.     if IndexDefs.Count < 1 then
  135.       ShowMessage('Table has no primary index!')
  136.     else
  137.     begin
  138.       FldList := TDoRxList.Create;
  139.       try
  140.         BDEGetFieldStructure(TmpTbl, FldList);
  141.         Pos := 1;
  142.         while (Pos <= Length(IndexDefs.Items[0].Fields)) do
  143.         begin
  144.           TmpFld := ExtractFieldName(IndexDefs.Items[0].Fields, Pos);
  145.           ListBox3.Items.Add(TmpFld+' ('+GetFldType(TmpFld,FldList)+')');
  146.         end;
  147.       finally
  148.         FldList.FreeAll;
  149.         FldList.Free;
  150.       end;
  151.     end;
  152.   finally
  153.     Free;
  154.   end;
  155. end;
  156.  
  157. procedure TRefIntFrm.ListBoxesDrawItem(Control: TWinControl; Index: Integer;
  158.   Rect: TRect; State: TOwnerDrawState);
  159. var Tw: integer;
  160. begin
  161.   with (Control as TListBox).Canvas do
  162.   begin
  163.     Brush.Color := clWindow;
  164.     FillRect(Rect);
  165.     Font.Color := clBlack;
  166.     Tw := TextWidth((Control as TListBox).Items[Index]);
  167.     TextOut(Rect.Left+((Rect.Right-Rect.Left-Tw) div 2),
  168.             Rect.Top, (Control as TListBox).Items[Index]);
  169.   end;
  170.   SetControlState;
  171. end;
  172.  
  173. procedure TRefIntFrm.SetControlState;
  174. var BtnEnable: boolean;
  175.     i: integer;
  176. begin
  177.   BtnEnable := (ListBox2.Items.Count > 0)
  178.                 and (ListBox2.Items.Count = ListBox3.Items.Count)
  179.                 and (Edit1.Text > '')
  180.                 and (ListBox4.Items.IndexOf(Edit1.Text) = -1);
  181.   if BtnEnable then
  182.     for i:=0 to pred(ListBox2.Items.Count) do
  183.       BtnEnable := CompareFldTypes(ListBox2.Items[i],ListBox3.Items[i]);
  184.   AddBtn.Enabled := BtnEnable;
  185.   DelBtn.Enabled := ListBox4.ItemIndex <> -1;
  186. end;
  187.  
  188. procedure TRefIntFrm.Edit1Change(Sender: TObject);
  189. begin
  190.   SetControlState;
  191. end;
  192.  
  193. procedure TRefIntFrm.ListBox4Click(Sender: TObject);
  194. begin
  195.   SetControlState;
  196. end;
  197.  
  198. procedure TRefIntFrm.AddBtnClick(Sender: TObject);
  199. const CRintQual: array[0..1] of RINTQual = (rintRESTRICT,rintCASCADE);
  200. var Fields1, Fields2: string;
  201.     i: integer;
  202. begin
  203.   Fields1 := '';
  204.   Fields2 := '';
  205.   for i:=0 to pred(ListBox2.Items.Count) do
  206.     Fields1 := Fields1+StripFldTypeFromString(ListBox2.Items[i])+';';
  207.   SetLength(Fields1,Length(Fields1)-1);
  208.   for i:=0 to pred(ListBox3.Items.Count) do
  209.     Fields2 := Fields2+StripFldTypeFromString(ListBox3.Items[i])+';';
  210.   SetLength(Fields2,Length(Fields2)-1);
  211.   try
  212.     BDEAddRIConstraint(MainFrm.Table1,
  213.                        ExtractFileName(FileListBox1.FileName),
  214.                        Edit1.Text,
  215.                        CRintQual[RadioGroup1.ItemIndex],
  216.                        rintRESTRICT,
  217.                        CheckBox1.Checked,
  218.                        Fields1, Fields2);
  219.   except
  220.     on E:EDoRxKeyViol do
  221.       ShowMessage(E.Message);
  222.     else raise;
  223.   end;
  224.   BDEGetRIList(MainFrm.Table1, ListBox4.Items);
  225. end;
  226.  
  227. procedure TRefIntFrm.DelBtnClick(Sender: TObject);
  228. begin
  229.   with ListBox4 do
  230.     BDEDropRIConstraint(MainFrm.Table1, Items[ItemIndex]);
  231.   BDEGetRIList(MainFrm.Table1, ListBox4.Items);
  232. end;
  233.  
  234. procedure TRefIntFrm.FormCreate(Sender: TObject);
  235. var i: integer;
  236. begin
  237.   CalcControlSize(self);
  238.   CalcCenterPos(nil, self);
  239.   with MainFrm.StrucGrid do
  240.     for i:=1 to pred(RowCount) do
  241.       ListBox1.Items.Add(Rows[i].Strings[0]+' ('+Rows[i].Strings[1]+')');
  242.   FileListBox1.Directory := GetDBPath(MainFrm.Database1.DataBaseName);
  243.   BDEGetRIList(MainFrm.Table1, ListBox4.Items);
  244. end;
  245.  
  246. procedure TRefIntFrm.CloseBtnClick(Sender: TObject);
  247. begin
  248.   ModalResult := mrOK;
  249. end;
  250.  
  251. procedure TRefIntFrm.RIInfoClick(Sender: TObject);
  252. var RIList: TStringList;
  253.     InfoForm: TInfoFrm;
  254. begin
  255.   RIList := TStringList.Create;
  256.   with RIList do
  257.   try
  258.     BDEGetRIDefsByName(MainFrm.Table1,ListBox4.Items[ListBox4.ItemIndex],RIList);
  259.     InfoForm := TInfoFrm.Create(Application);
  260.     with InfoForm.Memo1 do
  261.     try
  262.       Lines.Clear;
  263.       Lines.Add('Properties of RI constraint '+Values['Name']+':');
  264.       Lines.Add('');
  265.       Lines.Add('Type: '+#9#9+Values['Type']);
  266.       Lines.Add('DelOp: '+#9#9+Values['DelOp']);
  267.       Lines.Add('ModeOp: '+#9#9+Values['ModOp']);
  268.       Lines.Add('Other table: '+#9+Values['OtherTbl']);
  269.       Lines.Add('FieldNos in this table: '+#9+Values['ThisTabFlds']);
  270.       Lines.Add('FieldNos in other table: '+#9+Values['OthTabFlds']);
  271.       InfoForm.ShowModal;
  272.     finally
  273.       InfoForm.Free;
  274.     end;
  275.   finally
  276.     RIList.Free;
  277.   end;
  278. end;
  279.  
  280. procedure TRefIntFrm.PopupMenu1Popup(Sender: TObject);
  281. begin
  282.   RIInfo.Enabled := (ListBox4.ItemIndex > -1);
  283. end;
  284.  
  285. procedure TRefIntFrm.DepInfoClick(Sender: TObject);
  286. var RIList: TStringList;
  287.     InfoForm: TInfoFrm;
  288.     i: integer;
  289. begin
  290.   RIList := TStringList.Create;
  291.   with RIList do
  292.   try
  293.     InfoForm := TInfoFrm.Create(Application);
  294.     with InfoForm.Memo1 do
  295.     try
  296.       Lines.Clear;
  297.       Lines.Add('Dependent tables:');
  298.       Lines.Add('');
  299.       for i:=1 to MainFrm.FCurProps.iRefIntChecks do
  300.       begin
  301.         BDEGetRIDefsByNumber(MainFrm.Table1,i,RIList);
  302.         if (CompareText(Values['Type'],'rintMASTER') = 0) then
  303.         begin
  304.           Lines.Add(Values['OtherTbl']);
  305.         end;
  306.         if (Lines.Count = 2) then
  307.           Lines.Add('There are no dependent tables');
  308.       end;
  309.       InfoForm.ShowModal;
  310.     finally
  311.       InfoForm.Free;
  312.     end;
  313.   finally
  314.     RIList.Free;
  315.   end;
  316. end;
  317.  
  318. initialization
  319. begin
  320.   RefIntFrm := nil;
  321. end;
  322.  
  323. end.
  324.